home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / misc / unix.c < prev   
C/C++ Source or Header  |  1992-10-21  |  4KB  |  174 lines
  1. #include <errno.h>
  2. #include <sys/types.h>
  3. #include <sys/stat.h>
  4. #include <sys/param.h>
  5.  
  6. #include "scheme.h"
  7.  
  8. #ifdef DIRENT
  9. #  include <dirent.h>
  10. #else
  11. #  include <sys/dir.h>
  12. #endif
  13.  
  14. #ifdef SYSCONF
  15. #  include <unistd.h>
  16. #endif
  17.  
  18. extern int errno;
  19. extern char *getenv();
  20.  
  21. static Object P_Read_Directory (name) Object name; {
  22.     register char *s;
  23.     register DIR *d;
  24. #ifdef DIRENT
  25.     register struct dirent *dp;
  26. #else
  27.     register struct direct *dp;
  28. #endif
  29.     Object ret;
  30.     GC_Node;
  31.     Declare_C_Strings;
  32.  
  33.     ret = Null;
  34.     GC_Link (ret);
  35.     Make_C_String (name, s);
  36.     Disable_Interrupts;
  37.     if ((d = opendir (s)) == NULL)
  38.     Primitive_Error ("cannot open directory ~s", name);
  39.     while ((dp = readdir (d)) != NULL) {
  40.     Object x = Make_String (dp->d_name, strlen (dp->d_name));
  41.     ret = Cons (x, ret);
  42.     }
  43.     /* closedir() is void under 4.3BSD, should check result elsewhere.
  44.      */
  45.     (void)closedir (d);
  46.     Enable_Interrupts;
  47.     GC_Unlink;
  48.     Dispose_C_Strings;
  49.     return ret;
  50. }
  51.  
  52. static Object P_File_Status (name) Object name; {
  53.     register char *s;
  54.     Object ret;
  55.     struct stat st;
  56.     Declare_C_Strings;
  57.  
  58.     Make_C_String (name, s);
  59.     if (stat (s, &st) == -1) {
  60.     switch (errno) {
  61.     case ENOTDIR:
  62.     case EINVAL:
  63.     case ENOENT:
  64.     case EACCES:
  65. #ifdef ENAMETOOLONG
  66.     case ENAMETOOLONG:
  67. #endif
  68. #ifdef ELOOP
  69.     case ELOOP:
  70. #endif
  71.         s = "non-existent"; break;
  72.     default:
  73.         Saved_Errno = errno;
  74.         Primitive_Error ("cannot stat ~s: ~E", name);
  75.     }
  76.     } else {
  77.     switch (st.st_mode & S_IFMT) {
  78.     case S_IFDIR: s = "directory"; break;
  79.     case S_IFCHR: s = "character-special"; break;
  80.     case S_IFBLK: s = "block-special"; break;
  81.     case S_IFREG: s = "regular"; break;
  82. #ifdef S_IFSOCK
  83.     case S_IFSOCK: s = "socket"; break;
  84. #endif
  85. #ifdef S_IFFIFO
  86.     case S_IFFIFO: s = "fifo"; break;
  87. #endif
  88.     default: s = "unknown"; break;
  89.     }
  90.     }
  91.     ret = Intern (s);
  92.     Dispose_C_Strings;
  93.     return ret;
  94. }
  95.  
  96. static Open_Max () {
  97. #ifdef OPEN_MAX              /* POSIX */
  98.     return OPEN_MAX;
  99. #else
  100. #ifdef GETDTABLESIZE
  101.     return getdtablesize();  /* Return value may change during runtime */
  102. #else
  103. #ifdef SYSCONF
  104.     static r;
  105.     if (r == 0) {
  106.     if ((r = sysconf (_SC_OPEN_MAX)) == -1)
  107.         r = 256;
  108.     }
  109.     return r;
  110. #else
  111. #ifdef NOFILE
  112.     return NOFILE;
  113. #else
  114.     return 256;
  115. #endif
  116. #endif
  117. #endif
  118. #endif
  119. }
  120.  
  121. static Object P_System (cmd) Object cmd; {
  122.     register char *s;
  123.     register i, n, pid;
  124.     int status;
  125.     Declare_C_Strings;
  126.  
  127.     Make_C_String (cmd, s);
  128. #ifdef VFORK
  129.     switch (pid = vfork ()) {
  130. #else
  131.     switch (pid = fork ()) {
  132. #endif
  133.     case -1:
  134.     Saved_Errno = errno;
  135.     Primitive_Error ("cannot fork: ~E");
  136.     case 0:
  137.     n = Open_Max ();
  138.     for (i = 3; i < n; i++)
  139.         (void)close (i);
  140.     execl ("/bin/sh", "sh", "-c", s, (char *)0);
  141.     _exit (127);
  142.     default:
  143.     Disable_Interrupts;
  144.     while ((i = wait (&status)) != pid && i != -1)
  145.         ;
  146.     Enable_Interrupts;
  147.     }
  148.     Dispose_C_Strings;
  149.     if (i == -1)
  150.     return False;
  151.     if (n = (status & 0377))
  152.     return Cons (Make_Fixnum (n), Null);
  153.     return Make_Fixnum ((status >> 8) & 0377);
  154. }
  155.  
  156. static Object P_Getenv (e) Object e; {
  157.     register char *s;
  158.     Object ret;
  159.     Declare_C_Strings;
  160.  
  161.     Make_C_String (e, s);
  162.     ret = (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
  163.     Dispose_C_Strings;
  164.     return ret;
  165. }
  166.  
  167. init_lib_unix () {
  168.     Define_Primitive (P_Read_Directory, "read-directory", 1, 1, EVAL);
  169.     Define_Primitive (P_File_Status,    "file-status",    1, 1, EVAL);
  170.     Define_Primitive (P_System,         "system",         1, 1, EVAL);
  171.     Define_Primitive (P_Getenv,         "getenv",         1, 1, EVAL);
  172.     P_Provide (Intern ("unix"));
  173. }
  174.